home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue62 / Construc / UNIT62.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  2000-09-06  |  3.8 KB  |  115 lines
  1. unit Unit62;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   Db, DBClient, Grids, DBGrids, StdCtrls;
  6.  
  7. type
  8.   TForm1 = class(TForm)
  9.     CDS: TClientDataSet;
  10.     DataSource1: TDataSource;
  11.     DBGrid1: TDBGrid;
  12.     ButtonCancel: TButton;
  13.     ButtonOK: TButton;
  14.     Label1: TLabel;
  15.     EditFileName: TEdit;
  16.     CDSFieldName: TStringField;
  17.     CDSFieldType: TStringField;
  18.     CDSSize: TStringField;
  19.     procedure ButtonOKClick(Sender: TObject);
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.  
  25. implementation
  26. {$R *.DFM}
  27.  
  28. procedure TForm1.ButtonOKClick(Sender: TObject);
  29. var
  30.   F: System.Text;
  31.  
  32.   function Print(Str: String): String;
  33.   { Convert a fieldname to a printable name }
  34.   var
  35.     i: Integer;
  36.   begin
  37.     for i:=Length(Str) downto 1 do
  38.       if not (UpCase(Str[i]) in ['A'..'Z','1'..'9']) then
  39.         Str[i] := '_';
  40.     Result := Str
  41.   end {Printable};
  42.  
  43. begin
  44.   System.Assign(F,EditFileName.Text);
  45.   try
  46.     System.Rewrite(F);
  47.     writeln(F,'<?xml version="1.0" standalone="yes"?>');
  48.     writeln(F,'<DATAPACKET Version="2.0">');
  49.     writeln(F,'<METADATA>');
  50.     writeln(F,'<FIELDS>');
  51.     CDS.First;
  52.     while not CDS.Eof do
  53.     begin
  54.       write(F,' <FIELD ');
  55.       if Print(CDSFieldName.AsString) <> CDSFieldName.AsString then { fieldname }
  56.         write(F,'fieldname="'+CDSFieldName.AsString+'" ');
  57.       write(F,'attrname="'+Print(CDSFieldName.AsString)+'" fieldtype="');
  58.       if CDSFieldType.AsString = 'AutoInc' then
  59.         write(F,'i4" readonly="true" SUBTYPE="Autoinc') // AutoInc
  60.       else if CDSFieldType.AsString = 'Integer' then
  61.         write(F,'i4') // Integer
  62.       else if CDSFieldType.AsString = 'Smallint' then
  63.         write(F,'i2') // Smallint
  64.       else if (CDSFieldType.AsString = 'String') or
  65.               (CDSFieldType.AsString = 'WideString') or
  66.               (CDSFieldType.AsString = 'FixedChar') then
  67.         write(F,'string') // FixedChar, String, WideString
  68.       else if CDSFieldType.AsString = 'Memo' then
  69.         write(F,'bin.hex" SUBTYPE="Text') // Memo
  70.       else if CDSFieldType.AsString = 'BCD' then
  71.         write(F,'fixed') // BCD
  72.       else if (CDSFieldType.AsString = 'Blob') or
  73.               (CDSFieldType.AsString = 'VarBytes') then
  74.         write(F,'bin.hex" SUBTYPE="Binary') // Blob, VarBytes
  75.       else if CDSFieldType.AsString = 'Boolean' then
  76.         write(F,'boolean') // Boolean
  77.       else if CDSFieldType.AsString = 'Bytes' then
  78.         write(F,'bin.hex') // Bytes
  79.       else if CDSFieldType.AsString = 'Currency' then
  80.         write(F,'r8" SUBTYPE="Money') // Currency
  81.       else if CDSFieldType.AsString = 'Date' then
  82.         write(F,'date') // Date
  83.       else if CDSFieldType.AsString = 'DateTime' then
  84.         write(F,'datetime') // DateTime
  85.       else if (CDSFieldType.AsString = 'dBaseOle') or
  86.               (CDSFieldType.AsString = 'ParadoxOle') then
  87.         write(F,'bin.hex" SUBTYPE="Ole') // dBaseOle, ParadoxOle
  88.       else if (CDSFieldType.AsString = 'Float') or
  89.               (CDSFieldType.AsString = 'Word') then
  90.         write(F,'r8') // Float, Word
  91.       else if CDSFieldType.AsString = 'FmtMemo' then
  92.         write(F,'bin.hex" SUBTYPE="Formatted') // FmtMemo
  93.       else if (CDSFieldType.AsString = 'Graphic') or
  94.               (CDSFieldType.AsString = 'TypedBinary') then
  95.         write(F,'bin.hex" SUBTYPE="Graphics') // Graphic, TypedBinary
  96.       else if CDSFieldType.AsString = 'Time' then
  97.         write(F,'time'); // Time
  98.       if Length(CDSSize.AsString) > 0 then // 9,17,21
  99.         write(F,'" WIDTH="',CDSSize.AsString);
  100.       writeln(F,'"/>');
  101.       CDS.Next
  102.     end;
  103.     writeln(F,'</FIELDS>');
  104.     writeln(F,'</METADATA>');
  105.     writeln(F,'<ROWDATA>');
  106.     writeln(F,'</ROWDATA>');
  107.     writeln(F,'</DATAPACKET>');
  108.   finally
  109.     System.Close(F)
  110.   end;
  111.   Close
  112. end;
  113.  
  114. end.
  115.